//
// Include changes:
//  - Jan 12, 2014 Updated for Delphi XE5 by francois.piette@overbyte.be
//    Merged by David Millington for XE4

unit MandelbrotTiles;

interface

uses
  FMX.Types, System.Types, Tiles, Generics.Collections, DownloadThread, Interfaces, FMX.Ani,
  System.Classes;

type
  TMandelbrotTiles = class(TFmxObject)
  const
    FMinZoom = 1;
    FMaxZoom = 13; // As of Dec 27 2013, the highest level available - http://www.delphitools.info/2013/12/27/and-the-terapixel-became-four/
  private
    FZoomLevel : Double;
    FScrollX, FScrollY : Double; // Tile coordinates of the top-left of the screen
    FUIWidthPx,
    FUIHeightPx : Integer;
    FZoomTileList : array[FMinZoom..FMaxZoom] of TList<TTile>;
    FUIBitmap : TBitmap; // Not owned by this; it's the bmp to draw to
    FTileDownloader : TTileDownloader;
    FHostForm : IHostForm;
    FZoomAnimation : TFloatAnimation;

    procedure EnsureHasTile(const Zoom, X, Y : Integer);
    procedure DrawTile(const Tile : TTile; Bitmap : TBitmap);
    procedure GenerateTileBitmaps;
    function GetTileDestRect(const Tile : TTile) : TRectF;
    procedure GetScrollPosForZoom(const Zoom : Double; out ScrollX, ScrollY : Double);
    procedure GetTileSizeForZoom(const TileZoom : Double; out TileWidth, TileHeight : Double);
    procedure DeleteTileCallback(const DelTile : TTile); // TDeleteTileCallback
    procedure InternalSetZoom(const Value : Double);
    procedure ZoomAniProcess(Sender : TObject);
    procedure ZoomAniFinish(Sender : TObject);

    function GetTileCount : Integer;
    function GetTileMemoryBytes : Integer;
    function GetCanvasTypeName : string;
    function GetIsZooming: Boolean;
  public
    constructor Create(NeedToGenerateBitmap: IHostForm; UIBitmap : TBitmap; const UIWidth, UIHeight : Integer); reintroduce;
    destructor Destroy; override;

    procedure ClearAllTiles;
    procedure UpdateVisibleTiles;
    procedure UpdateVisibleTilesForZoom(const Zoom : Integer);
    procedure PurgeOffscreenTiles;

    procedure DrawToUIBitmap;
    procedure DrawToBitmap(Bitmap : TBitmap);

    procedure SetUISize(const Width, Height : Integer);
    procedure ScrollByPixels(const XDiff, YDiff : Integer);
    procedure IncZoom;
    procedure DecZoom;
    procedure SetZoomAni(const Value : Double);
    function IsWorking : Boolean;

    function GetMinZoom : Integer;
    function GetMaxZoom : Integer;
  published
    property ZoomLevel : Double read FZoomLevel write InternalSetZoom;
    property CoordX : Double read FScrollX;
    property CoordY : Double read FScrollY;
    property TileCount : Integer read GetTileCount;
    property TileMemoryBytes : Integer read GetTileMemoryBytes;
    property CanvasTypeName : string read GetCanvasTypeName;
    property IsZooming : Boolean read GetIsZooming;
  end;

implementation

uses
  Math, ColorMapping, SysUtils, FMX.Forms;

{ TMandelbrotTiles }

constructor TMandelbrotTiles.Create(NeedToGenerateBitmap : IHostForm; UIBitmap : TBitmap; const UIWidth, UIHeight :
  Integer);
var
  Loop : Integer;
begin
  inherited Create(nil);

  FZoomLevel := 1.0;
  FScrollX := 1.0;
  FScrollY := 1.0;
  FZoomAnimation := nil;
  FUIBitmap := UIBitmap; // The bitmap to draw onto, not owned by this object
  FUIWidthPx := UIWidth;
  FUIHeightPx := UIHeight;
  for Loop := Low(FZoomTileList) to High(FZoomTileList) do begin
    FZoomTileList[Loop] := TList<TTile>.Create;
  end;
  FTileDownloader := TTileDownloader.Create(NeedToGenerateBitmap);
  FHostForm := NeedToGenerateBitmap;
end;

destructor TMandelbrotTiles.Destroy;
var
  Loop : Integer;
begin
  ClearAllTiles;
  FTileDownloader.Free;
  for Loop := Low(FZoomTileList) to High(FZoomTileList) do begin
    FZoomTileList[Loop].Free;
  end;
  FZoomAnimation.Free;

  inherited;
end;

procedure TMandelbrotTiles.DrawToUIBitmap;
begin
  // The tile bitmap has to be created and drawn to in the main thread: the FMX Direct2D canvas,
  // at least, doesn't support drawing to a TBitmap in one thread and then later drawing using that
  // TBitmap in another. So, process any tiles that need to be converted here.

  if not IsZooming then // Slightly smoother if it doesn't do this work while animating the zoom
    GenerateTileBitmaps;

  DrawToBitmap(FUIBitmap);
end;

procedure TMandelbrotTiles.DrawToBitmap(Bitmap: TBitmap);
var
  Tile : TTile;
  Zoom : Integer;
begin
  // Often zero on startup
  if (Bitmap.Width = 0) or (Bitmap.Height = 0) then Exit;

  Bitmap.Canvas.BeginScene;
  try
    Bitmap.Clear(ColorForValue(0)); // To match the outside / level-1 background

    // Draw tiles of all zoom levels up to the highest-res one. This means low-res tiles will draw
    // while higher-res ones are loading (zooming in), or higher-res while lower-res are loading
    // (zooming out)
    for Zoom := Low(FZoomTileList) to High(FZoomTileList) do begin
      for Tile in FZoomTileList[Zoom] do begin
        assert(Tile.Zoom = Zoom); // Just check tile was added to the right list
        if Tile.CanDraw then begin
          DrawTile(Tile, Bitmap);
        end;
      end;
    end;
  finally
    Bitmap.Canvas.EndScene;
  end;
end;

procedure TMandelbrotTiles.DrawTile(const Tile: TTile; Bitmap : TBitmap);
var
  ScreenRect, TileDestRect : TRectF;
begin
  // Only draw if it's going to be onscreen
  ScreenRect := RectF(0, 0, FUIWidthPx, FUIHeightPx);
  TileDestRect := GetTileDestRect(Tile);
  if ScreenRect.IntersectsWith(TileDestRect) then begin
    Bitmap.Canvas; // Force the canvas to be created, can stay nil otherwise!
    Tile.Draw(Bitmap, TileDestRect);
  end;
end;

procedure TMandelbrotTiles.GenerateTileBitmaps;
var
  Zoom : Integer;
  Tile : TTile;
begin
  // The tile bitmap has to be created and drawn to in the main thread: the FMX Direct2D canvas,
  // at least, doesn't support drawing to a TBitmap in one thread and then drawing using that
  // TBitmap in another. So, process any tiles that need to be converted here.
  // This is not particularly efficient: most of the time, all tiles will have nothing to do.
  // In practice there are only a few tiles (<40) onscreen at any one time, so the loop doesn't
  // incur too much overhead.
  for Zoom := Low(FZoomTileList) to High(FZoomTileList) do
    for Tile in FZoomTileList[Zoom] do
      if Tile.NeedToProcessBitmap then Tile.GenerateBitmap;
end;

procedure TMandelbrotTiles.ScrollByPixels(const XDiff, YDiff: Integer);
var
  ScrollIncX, ScrollIncY : Double;
  TileWidth, TileHeight : Double;
begin
  // Each pixel onscreen moves the scroll by a certain amount:
  // A tile unit is 256 pixels wide / high, so each pixel moved onscreen is 1/256
  // But when zoomed in, that amount is doubled for every zoom level
  // There is a bug here: at non-integer zoom levels the point under the mouse doesn't stay exactly
  // under the mouse. (It's close though.) It is fine for integer zooms.
  GetTileSizeForZoom(FZoomLevel, TileWidth, TileHeight);
  ScrollIncX := XDiff * (1.0 / TileWidth);
  ScrollIncX := ScrollIncX / Power(2.0, FZoomLevel - 1.0);
  ScrollIncY := YDiff * (1.0 / TileHeight);
  ScrollIncY := ScrollIncY / Power(2.0, FZoomLevel - 1.0);
  FScrollX := FScrollX - ScrollIncX;
  FScrollY := FScrollY - ScrollIncY;

  UpdateVisibleTiles;
  FHostForm.UpdateInformation;
end;

procedure TMandelbrotTiles.SetUISize(const Width, Height: Integer);
begin
  FUIWidthPx := Width;
  FUIHeightPx := Height;
end;

function TMandelbrotTiles.IsWorking: Boolean;
begin
  Result := Assigned(FTileDownloader) and FTileDownloader.IsWorking;
end;

procedure TMandelbrotTiles.PurgeOffscreenTiles;
var
  Loop,
  CurrentZoom : Integer;
  Tile : TTile;
  ScreenRect, TileDestRect : TRectF;
begin
  // Get rid of all tiles that aren't needed for drawing, that is:
  // - all tiles not near the current zoom level (for fraction zoom, eg zoom 2.5, all tiles not in
  //   zoom 3);
  // - all tiles in the current zoom level that do not overlap the screen

  // Thread is doing something again; don't edit the tile list because threads may hold tile references
  // and crash when tiles are deleted from under them
  if IsWorking then Exit;

  CurrentZoom := Min(Ceil(FZoomLevel), High(FZoomTileList)); // Zoom level of high-res tiles
  for Loop := Low(FZoomTileList) to High(FZoomTileList) do begin
    if Loop = CurrentZoom then continue;
    for Tile in FZoomTileList[Loop] do begin // Delete all tiles
      Tile.Free;
    end;
    FZoomTileList[Loop].Clear;
  end;

  // For tiles in the current zoom, delete all tiles that don't overlap the screen
  ScreenRect := RectF(0, 0, FUIWidthPx, FUIHeightPx);
  for Loop := FZoomTileList[CurrentZoom].Count-1 downto 0 do begin // Reverse order because deleting
    Tile := FZoomTileList[CurrentZoom][Loop];
    TileDestRect := GetTileDestRect(Tile);
    if not ScreenRect.IntersectsWith(TileDestRect) then begin
      Tile.Free;
      FZoomTileList[CurrentZoom].Delete(Loop);
    end;
  end;

  FHostForm.UpdateInformation;
end;

procedure TMandelbrotTiles.IncZoom;
begin
  ZoomLevel := ZoomLevel + 1.0;
end;

procedure TMandelbrotTiles.DecZoom;
begin
  ZoomLevel := ZoomLevel - 1.0;
end;

procedure TMandelbrotTiles.InternalSetZoom(const Value: Double);
begin
  if FZoomLevel = Value then Exit;

  FZoomLevel := Min(Max(Value, FMinZoom), FMaxZoom); // Ensure it's within bounds
  UpdateVisibleTiles;
  FHostForm.UpdateInformation;
  FHostForm.RepaintUI; // Because setting this value can be animated
end;

procedure TMandelbrotTiles.SetZoomAni(const Value: Double);
begin
  // Animate setting the zoom. If it's already being animated (eg clicking zoom-in several times
  // quickly) animate from wherever it is
  if not Assigned(FZoomAnimation) then begin
    FZoomAnimation := TFloatAnimation.Create(nil);
    FZoomAnimation.Parent := Self;
    FZoomAnimation.SetRoot(FHostForm.GetIRoot);
    FZoomAnimation.PropertyName := 'ZoomLevel';
    FZoomAnimation.OnProcess := ZoomAniProcess;
    FZoomAnimation.OnFinish := ZoomAniFinish;
    FZoomAnimation.AnimationType := TAnimationType.atIn;
    FZoomAnimation.Interpolation := TInterpolationType.itSinusoidal;
    FZoomAnimation.Loop := False;
    FZoomAnimation.Duration := 0.5;
  end;

  FZoomAnimation.StartFromCurrent := True;
  FZoomAnimation.StartValue := FZoomLevel;
  FZoomAnimation.StopValue := Min(Max(Value, FMinZoom), FMaxZoom); // Ensure it's within bounds
  FZoomAnimation.Enabled := true;
  FZoomAnimation.Start;
end;

procedure TMandelbrotTiles.ZoomAniProcess(Sender: TObject);
begin
  FHostForm.RepaintUI;
end;

procedure TMandelbrotTiles.ZoomAniFinish(Sender: TObject);
begin
  // Don't free the animation here - can cause an AV
end;

procedure TMandelbrotTiles.ClearAllTiles;
var
  TileList : TList<TTile>;
  Tile : TTile;
begin
  // Before clearing the tile list, need to stop the downloading thread which writes to tiles
  FTileDownloader.ClearAll;

  for TileList in FZoomTileList do begin
    for Tile in TileList do Tile.Free;
    TileList.Clear;
  end;
end;

procedure TMandelbrotTiles.UpdateVisibleTiles;
begin
  // If zoom is non-integer, get the tiles at integer zooms above and below the zoom
  UpdateVisibleTilesForZoom(Floor(FZoomLevel));
  if Floor(FZoomLevel) <> Ceil(FZoomLevel) then
    UpdateVisibleTilesForZoom(Ceil(FZoomLevel));

  // Now remove tiles that don't need to be downloaded (either of the above two zoom levels)
  // Just remove from the download queue: they will be purged from memory completely when the DL
  // queue is exhausted
  // This handles zooming in several times in a row: lots of tiles will be added with each zoom-in,
  // but we only want to download the latest set. Leave whatever tiles are in memory already
  // so that they can be drawn (eg so low-res ones draw until high-res ones are loaded.)
  FTileDownloader.RemoveQueuedDownloadsNotInZoomRange(Floor(FZoomLevel), Ceil(FZoomLevel), DeleteTileCallback);

  FHostForm.UpdateInformation;
end;

procedure TMandelbrotTiles.UpdateVisibleTilesForZoom(const Zoom: Integer);
var
  NumTilesX,
  NumTilesY : Integer;
  FirstTileX,
  FirstTileY : Integer;
  LoopX, LoopY : Integer;
  ScrollX, ScrollY : Double;
  TileWidth, TileHeight : Double;
begin
  if (Zoom < FMinZoom) or (Zoom > FMaxZoom) then Exit; // Seen with some FMX zoom animations

  GetScrollPosForZoom(Zoom, ScrollX, ScrollY);
  GetTileSizeForZoom(Zoom, TileWidth, TileHeight);
  // A tile is 256 (TILEWIDTH and TILEHEIGHT) pixels wide / high, so need as many as will fit in the
  // UI width/height, plus one (because may be scrolled partway through some.)
  NumTilesX := Ceil(FUIWidthPx / TileWidth) + 1;
  NumTilesY := Ceil(FUIHeightPx / TileHeight) + 1;
  // The top-left tile indices
  FirstTileX := Floor(ScrollX) - Round((FUIWidthPx / 2) / TileWidth) - 1;
  FirstTileY := Floor(ScrollY) - Round((FUIHeightPx / 2) / TileHeight) - 1;
  // Now make sure each of these tiles exists (starts the downloading process too if necessary)
  for LoopX := FirstTileX to FirstTileX + NumTilesX do begin
    for LoopY := FirstTileY to FirstTileY + NumTilesY do begin
      EnsureHasTile(Zoom, LoopX, LoopY);
    end;
  end;
end;

procedure TMandelbrotTiles.EnsureHasTile(const Zoom, X, Y: Integer);
var
  Tile : TTile;
  ScreenRect, TileDestRect : TRectF;
begin
  if TTile.OutOfBounds(Zoom, X, Y) then Exit;

  // Just a linear search
  for Tile in FZoomTileList[Zoom] do begin
    if Tile.Matches(Zoom, X, Y) then Exit;
  end;

  // At this point, no tile found.  Add it to the list and to the downloading thread
  Tile := TTile.Create(Zoom, X, Y);
  // Will it be visible onscreen? EnsureHasTile called for possible border tiles when scrolling too
  ScreenRect := RectF(0, 0, FUIWidthPx, FUIHeightPx);
  TileDestRect := GetTileDestRect(Tile);
  if ScreenRect.IntersectsWith(TileDestRect) then begin
    FZoomTileList[Zoom].Add(Tile);
    FTileDownloader.AddTile(Tile);
    // And get the form to display the spinner that work is happening
    FHostForm.UpdateShowSpinner;
    FHostForm.UpdateInformation; // More tiles
  end else begin
    Tile.Free;
  end;
end;

function TMandelbrotTiles.GetMinZoom: Integer;
begin
  Result := FMinZoom;
end;

function TMandelbrotTiles.GetMaxZoom: Integer;
begin
  Result := FMaxZoom;
end;

procedure TMandelbrotTiles.GetScrollPosForZoom(const Zoom: Double; out ScrollX, ScrollY: Double);
begin
  // The coordinates double for each zoom level in, and are assumed to be stored for zoom == 1
  ScrollX := FScrollX * Power(2.0, Zoom-1.0);
  ScrollY := FScrollY * Power(2.0, Zoom-1.0);
end;

procedure TMandelbrotTiles.GetTileSizeForZoom(const TileZoom : Double; out TileWidth, TileHeight: Double);
var
  Frac : Double;
begin
  // The tile size changes as you zoom in, linearly from tilesize to tilesize*2
  Frac := FZoomLevel - TileZoom; // Eg tile zoom 3.5, real zoom 3, becomes 0.5
  TileWidth := TILE_WIDTH * Power(2.0, Frac);
  TileHeight := TILE_HEIGHT * Power(2.0, Frac);
end;

function TMandelbrotTiles.GetTileDestRect(const Tile: TTile): TRectF;
var
  X, Y, TileWidth, TileHeight : Double;
  ScrollX, ScrollY : Double;
begin
  // Tile pos, offset by scroll pos
  GetTileSizeForZoom(Tile.Zoom, TileWidth, TileHeight);
  GetScrollPosForZoom(Tile.Zoom, ScrollX, ScrollY);
  X := (Tile.X * TileWidth) - (ScrollX * TileWidth) + (FUIWidthPx div 2);
  Y := (Tile.Y * TileHeight) - (ScrollY * TileHeight) + (FUIHeightPx div 2);

  Result := RectF(X, Y, X + TileWidth, Y + TileHeight);
end;

function TMandelbrotTiles.GetTileCount: Integer;
var
  TileList : TList<TTile>;
begin
  Result := 0;
  for TileList in FZoomTileList do
    Inc(Result, TileList.Count);
end;

function TMandelbrotTiles.GetTileMemoryBytes: Integer;
var
  TileList : TList<TTile>;
  Tile : TTile;
begin
  Result := 0;
  for TileList in FZoomTileList do
    for Tile in TileList do
      Inc(Result, Tile.GetApproxMemBytes);
end;

function TMandelbrotTiles.GetCanvasTypeName: string;
begin
  Result := FUIBitmap.Canvas.ClassName;
end;

function TMandelbrotTiles.GetIsZooming: Boolean;
begin
  Result := Assigned(FZoomAnimation) and FZoomAnimation.Running;
end;

procedure TMandelbrotTiles.DeleteTileCallback(const DelTile: TTile);
var
  TileList : TList<TTile>;
  Loop : Integer;
begin
  TileList := FZoomTileList[DelTile.Zoom];
  for Loop := TileList.Count-1 downto 0 do begin
    if TileList[Loop] = DelTile then begin
      DelTile.Free;
      TileList.Delete(Loop);
      Exit;
    end;
  end;
end;

end.
